home *** CD-ROM | disk | FTP | other *** search
/ Ham Radio 2000 #1 / Ham Radio 2000.iso / ham2000 / packet / p_aa4re / bb212src / bbsdata.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1992-01-11  |  45.5 KB  |  1,205 lines
  1. (*===========================================================================*)
  2. (* Used to send/control data frames to TNC                                   *)
  3. (*                                                                           *)
  4. (*   Copyright 1988, 1989, 1990, 1991 by H. Roy Engehausen.  All rights      *)
  5. (*   reserved.                                                               *)
  6. (*                                                                           *)
  7. (*===========================================================================*)
  8.  
  9. {$UNDEF DEBUG}
  10. {$UNDEF TRACE}
  11. {$UNDEF WRITE}
  12. {$UNDEF DEBUG2}  (* Used to debug receive frame pending *)
  13. {$UNDEF DEBUG3} (* Used to debug receive frame pending *)
  14.  
  15. UNIT BBSDATA;
  16.  
  17. INTERFACE
  18.  
  19. USES
  20.   bbdummy;
  21.  
  22. PROCEDURE send_tnc_data_str(in_str  : STRING);
  23. PROCEDURE send_tnc_data    (in_long : str_mixed_ptr);
  24. PROCEDURE send_tnc_data_ub (from_here : POINTER; length_to_send : WORD);
  25. FUNCTION  send_unacked(ignore_r_pending : BOOLEAN) : BYTE;
  26. FUNCTION  send_pending(ignore_r_pending : BOOLEAN) : BYTE;
  27. PROCEDURE send_flush;
  28. PROCEDURE send_drain;
  29.  
  30. IMPLEMENTATION
  31.  
  32. USES
  33.   CRT,
  34.   DOS,
  35.   bblc,
  36.   bblstr,
  37.   bbmisc4,
  38.   bbmore,
  39.   bbsess,
  40.   bbsrt,
  41.   bbstack,
  42.   bbstr,
  43.   bbtask,
  44.   bbtrace,
  45.   bbwin;
  46.  
  47. {$I BBMACRO.PAS}
  48.  
  49. (*===========================================================================*)
  50. (* Forwards                                                                  *)
  51. (*===========================================================================*)
  52.  
  53. PROCEDURE put_a_packet;    FORWARD;
  54. PROCEDURE put_data_error;  FORWARD;
  55.  
  56. (*===========================================================================*)
  57. (* Add linefeeds                                                             *)
  58. (*===========================================================================*)
  59.  
  60. PROCEDURE add_lf;
  61.  
  62.   VAR
  63.     i : WORD;
  64.     l : WORD;
  65.  
  66.   BEGIN;
  67.  
  68.     (*-----------------------------------------------------------------------*)
  69.     (* Only do this on telephones and not binary                             *)
  70.     (*-----------------------------------------------------------------------*)
  71.  
  72.     IF (active_port^.port_type <> port_modem)
  73.              OR NOT active_port^.modem_crlf
  74.              OR active_tcb^.tcb_binary THEN
  75.       EXIT;
  76.  
  77.     (*-----------------------------------------------------------------------*)
  78.     (* Get ready for loop                                                    *)
  79.     (*-----------------------------------------------------------------------*)
  80.  
  81.     i := 0;
  82.     l := active_tcb^.o_data.long_length;
  83.  
  84. {$IFDEF DEBUG}
  85. WRITELN('1) i = ', i, ' -- l = ', l);
  86. {$ENDIF}
  87.  
  88.     (*-----------------------------------------------------------------------*)
  89.     (* Loop adding linefeeds                                                 *)
  90.     (*-----------------------------------------------------------------------*)
  91.  
  92.     WHILE (i < l) AND (l < SIZEOF(active_tcb^.o_data.long_data)) DO
  93.       BEGIN;
  94.  
  95.         INC(i);
  96.  
  97.         (*-------------------------------------------------------------------*)
  98.         (* CR without LF                                                     *)
  99.         (*-------------------------------------------------------------------*)
  100.  
  101.         IF (active_tcb^.o_data.long_data[i] = cr)
  102.              AND ((i = l) OR (active_tcb^.o_data.long_data[i+1] <> lf)) THEN
  103.           BEGIN;
  104.  
  105. {$IFDEF DEBUG}
  106. WRITELN('2) i = ', i, ' -- l = ', l);
  107. {$ENDIF}
  108.  
  109.             (*---------------------------------------------------------------*)
  110.             (* Shift everything right                                        *)
  111.             (*---------------------------------------------------------------*)
  112.  
  113.             MOVE(active_tcb^.o_data.long_data[i+1],
  114.                  active_tcb^.o_data.long_data[i+2],
  115.                  l-i);
  116.  
  117.             (*---------------------------------------------------------------*)
  118.             (* Add linefeed                                                  *)
  119.             (*---------------------------------------------------------------*)
  120.  
  121.             active_tcb^.o_data.long_data[i+1] := lf;
  122.  
  123.             (*---------------------------------------------------------------*)
  124.             (* Bump counters                                                 *)
  125.             (*---------------------------------------------------------------*)
  126.  
  127.             INC(l);
  128.             INC(i);
  129.  
  130. {$IFDEF DEBUG}
  131. stack_depth;
  132. {$ENDIF}
  133.  
  134.           END; (*----- End of adding a LF -----------------------------------*)
  135.  
  136.       END; (*----- End loop thru the packet ---------------------------------*)
  137.  
  138.     (*-----------------------------------------------------------------------*)
  139.     (* Set new length                                                        *)
  140.     (*-----------------------------------------------------------------------*)
  141.  
  142.     active_tcb^.o_data.long_length := l;
  143.     IF l > 255 THEN
  144.       l := 255;
  145.     active_tcb^.o_data.str_data[0] := CHR(l);
  146.  
  147. {$IFDEF DEBUG}
  148. WRITELN('3) i = ', i, ' -- l = ', l);
  149. {$ENDIF}
  150.  
  151.   END; (*----- End of add_lf ------------------------------------------------*)
  152.  
  153. (*===========================================================================*)
  154. (* Unblocked data send                                                       *)
  155. (*===========================================================================*)
  156.  
  157. PROCEDURE send_tnc_data_ub (from_here : POINTER; length_to_send : WORD);
  158.  
  159.   TYPE
  160.     array_overlay = ARRAY[0..10000] OF BYTE;
  161.  
  162.   VAR
  163.     data_place     : ^array_overlay;
  164.     current_length : WORD;
  165.     length_to_move : WORD;
  166.     this_max_pac   : WORD;
  167.  
  168.   BEGIN;
  169.  
  170.     data_place := from_here;
  171.  
  172.     (*-----------------------------------------------------------------------*)
  173.     (* Get maximum packet size                                               *)
  174.     (*-----------------------------------------------------------------------*)
  175.  
  176.     this_max_pac := active_tcb^.max_pac;
  177.  
  178.     (*-----------------------------------------------------------------------*)
  179.     (* If buffer is full then flush                                          *)
  180.     (*-----------------------------------------------------------------------*)
  181.  
  182.     IF active_tcb^.o_data.long_length >= this_max_pac THEN
  183.       send_flush;
  184.  
  185.     (*-----------------------------------------------------------------------*)
  186.     (* Get current length in buffer                                          *)
  187.     (*-----------------------------------------------------------------------*)
  188.  
  189.     current_length := active_tcb^.o_data.long_length;
  190.  
  191.     (*-----------------------------------------------------------------------*)
  192.     (* Loop until nothing left to send                                       *)
  193.     (*-----------------------------------------------------------------------*)
  194.  
  195.     WHILE length_to_send > 0 DO
  196.       BEGIN;
  197.  
  198.         (*-------------------------------------------------------------------*)
  199.         (* Calculate space in buffer                                         *)
  200.         (*-------------------------------------------------------------------*)
  201.  
  202.         length_to_move := this_max_pac - current_length;
  203.  
  204.         (*-------------------------------------------------------------------*)
  205.         (* If we have less data than space, just move data                   *)
  206.         (*-------------------------------------------------------------------*)
  207.  
  208.         IF length_to_send < length_to_move THEN
  209.           length_to_move := length_to_send;
  210.  
  211.         (*-------------------------------------------------------------------*)
  212.         (* Move data                                                         *)
  213.         (*-------------------------------------------------------------------*)
  214.  
  215.         MOVE(data_place^,
  216.              active_tcb^.o_data.long_data[current_length + 1],
  217.              length_to_move);
  218.  
  219.         (*-------------------------------------------------------------------*)
  220.         (* Bump counters appropriately                                       *)
  221.         (*-------------------------------------------------------------------*)
  222.  
  223.         INC(current_length, length_to_move);
  224.         DEC(length_to_send, length_to_move);
  225.  
  226.         (*-------------------------------------------------------------------*)
  227.         (* Fill in lengths                                                   *)
  228.         (*-------------------------------------------------------------------*)
  229.  
  230.         active_tcb^.o_data.long_length := current_length;
  231.  
  232.         active_tcb^.o_data.str_data[0] := CHR(min_w(255, current_length));
  233.  
  234.         (*-------------------------------------------------------------------*)
  235.         (* Write the packet                                                  *)
  236.         (*-------------------------------------------------------------------*)
  237.  
  238.         put_a_packet;
  239.  
  240.         (*-------------------------------------------------------------------*)
  241.         (* Nothing left in buffer                                            *)
  242.         (*-------------------------------------------------------------------*)
  243.  
  244.         current_length := 0;
  245.  
  246.         (*-------------------------------------------------------------------*)
  247.         (* Adjust data pointer                                               *)
  248.         (*-------------------------------------------------------------------*)
  249.  
  250.         data_place := @data_place^[length_to_move];
  251.  
  252.       END; (*----- Loop sending data ----------------------------------------*)
  253.  
  254.   END;
  255.  
  256. (*===========================================================================*)
  257. (* Long data send                                                            *)
  258. (*===========================================================================*)
  259.  
  260. PROCEDURE send_tnc_data(in_long : str_mixed_ptr);
  261.  
  262.   VAR
  263.     this_max_pac : WORD;
  264.     this_o_data  : str_mixed_ptr;
  265.  
  266.   BEGIN;
  267.  
  268.     this_max_pac := active_tcb^.max_pac;
  269.     IF this_max_pac = 0 THEN
  270.       this_max_pac := 255;
  271.  
  272.  
  273.     IF active_tcb^.o_data.long_length + in_long^.long_length
  274.                                                             > this_max_pac THEN
  275.       BEGIN;
  276.  
  277.         put_a_packet;
  278.  
  279.         l_cat_size(@active_tcb^.o_data, in_long, this_max_pac);
  280.  
  281.         IF in_long^.long_length <> 0 THEN
  282.           BEGIN;
  283.             put_a_packet;
  284.             active_tcb^.o_data := in_long^;
  285.           END;
  286.  
  287.       END
  288.     ELSE
  289.       l_cat_size(@active_tcb^.o_data, in_long, this_max_pac);
  290.  
  291.   END;
  292.  
  293. (*===========================================================================*)
  294. (* String data send                                                          *)
  295. (*===========================================================================*)
  296.  
  297. PROCEDURE send_tnc_data_str(in_str : STRING);
  298.  
  299. {$UNDEF DEBUG}
  300.  
  301.   VAR
  302.     i            : WORD;
  303.     this_max_pac : WORD;
  304.     this_o_data  : str_mixed_ptr;
  305.  
  306.   BEGIN;
  307.  
  308.     (*-----------------------------------------------------------------------*)
  309.     (* Increment more                                                        *)
  310.     (*-----------------------------------------------------------------------*)
  311.  
  312.     more_add_str(in_str);
  313.  
  314.     (*-----------------------------------------------------------------------*)
  315.     (* Get the current max pac and buffer                                    *)
  316.     (*-----------------------------------------------------------------------*)
  317.  
  318.     this_max_pac := active_tcb^.max_pac;
  319.     this_o_data  := @active_tcb^.o_data;
  320.  
  321.     (*-----------------------------------------------------------------------*)
  322.     (* A little debugging please                                             *)
  323.     (*-----------------------------------------------------------------------*)
  324.  
  325.     {$IFDEF DEBUG}
  326.       stack_push('');
  327.     {$ENDIF}
  328.  
  329.     (*-----------------------------------------------------------------------*)
  330.     (* Find out if there is a carriage return in the data already processed  *)
  331.     (*-----------------------------------------------------------------------*)
  332.  
  333.     i := l_pos(@active_tcb^.o_data, cr);
  334.     IF i > 255 THEN
  335.       i := 0;
  336.  
  337.     (*-----------------------------------------------------------------------*)
  338.     (* A little debugging please                                             *)
  339.     (*-----------------------------------------------------------------------*)
  340.  
  341.     {$IFDEF DEBUG}
  342.     stack_test('SDATA1');
  343.  
  344.       {$IFDEF TRACE}
  345.         trace_data('1T', active_tcb^.o_data.long_length, NIL,
  346.                                                       active_tcb^.o_data.str_data);
  347.         trace_data('1I', LENGTH(in_str),           NIL, in_str);
  348.       {$ENDIF}
  349.  
  350.       {$IFDEF WRITE}
  351.         WRITELN('1T ', active_tcb^.o_data.long_length, ' -- ',
  352.                                                       active_tcb^.o_data.str_data);
  353.         WRITELN('1I ', LENGTH(in_str), ' -- ', in_str);
  354.       {$ENDIF}
  355.  
  356.     {$ENDIF}
  357.  
  358.     (*-----------------------------------------------------------------------*)
  359.     (* See if we will exceed maximum packet size                             *)
  360.     (*-----------------------------------------------------------------------*)
  361.  
  362.     IF (this_o_data^.long_length + LENGTH(in_str)) > this_max_pac THEN
  363.       BEGIN;
  364.  
  365.         (*-------------------------------------------------------------------*)
  366.         (* Maximum packet size to be exceeded!                               *)
  367.         (*-------------------------------------------------------------------*)
  368.  
  369.         (*-------------------------------------------------------------------*)
  370.         (* A little debugging please                                         *)
  371.         (*-------------------------------------------------------------------*)
  372.  
  373.         {$IFDEF DEBUG}
  374.  
  375.           {$IFDEF TRACE}
  376.             trace_data('2T', this_o_data^.long_length, NIL,
  377.                                                         this_o_data^.str_data);
  378.             trace_data('2I', LENGTH(in_str),           NIL, in_str);
  379.           {$ENDIF}
  380.  
  381.           {$IFDEF WRITE}
  382.             WRITELN('2T ', this_o_data^.long_length, ' -- ',
  383.                                                         this_o_data^.str_data);
  384.             WRITELN('2I ', LENGTH(in_str), ' -- ', in_str);
  385.           {$ENDIF}
  386.  
  387.         {$ENDIF}
  388.  
  389.         (*-------------------------------------------------------------------*)
  390.         (* Maximum packet size to be exceeded!  If transparent mode or if    *)
  391.         (* we don't have a CR yet, fill out the buffer.                      *)
  392.         (*-------------------------------------------------------------------*)
  393.  
  394.         IF ((active_tcb^.uid_data.user_flag AND user_f_trans) <> 0)
  395.                                                                 OR (i = 0) THEN
  396.           l_cat_str_size(this_o_data, in_str, this_max_pac);
  397.  
  398.         (*-------------------------------------------------------------------*)
  399.         (* A little debugging please                                         *)
  400.         (*-------------------------------------------------------------------*)
  401.  
  402.         {$IFDEF DEBUG}
  403.  
  404.           stack_test('SDATA3');
  405.  
  406.           {$IFDEF TRACE}
  407.             trace_data('3T', this_o_data^.long_length, NIL,
  408.                                                        this_o_data^.str_data);
  409.             trace_data('3I', LENGTH(in_str),           NIL, in_str);
  410.           {$ENDIF}
  411.  
  412.           {$IFDEF WRITE}
  413.             WRITELN('3T ', this_o_data^.long_length, ' -- ',
  414.                                                         this_o_data^.str_data);
  415.             WRITELN('3I ', LENGTH(in_str), ' -- ', in_str);
  416.           {$ENDIF}
  417.  
  418.         {$ENDIF}
  419.  
  420.         (*-------------------------------------------------------------------*)
  421.         (* Take the packet we just built and write it out                    *)
  422.         (*-------------------------------------------------------------------*)
  423.  
  424.         put_a_packet;
  425.  
  426.         (*-------------------------------------------------------------------*)
  427.         (* A little debugging please                                         *)
  428.         (*-------------------------------------------------------------------*)
  429.  
  430.        {$IFDEF DEBUG}
  431.  
  432.          stack_test('SDATA4'); (*STACK TEST*)
  433.  
  434.          {$IFDEF TRACE}
  435.            trace_data('4T', this_o_data^.long_length, NIL,
  436.                                                         this_o_data^.str_data);
  437.            trace_data('4I', LENGTH(in_str),           NIL, in_str);
  438.          {$ENDIF}
  439.  
  440.          {$IFDEF WRITE}
  441.            WRITELN('4T ', this_o_data^.long_length, ' -- ',
  442.                                                         this_o_data^.str_data);
  443.            WRITELN('4I ', LENGTH(in_str), ' -- ', in_str);
  444.          {$ENDIF}
  445.  
  446.        {$ENDIF}
  447.  
  448.         (*-------------------------------------------------------------------*)
  449.         (* Stick the next bunch of data into the packet                      *)
  450.         (*-------------------------------------------------------------------*)
  451.  
  452.         l_cat_str_size(this_o_data, in_str, this_max_pac);
  453.  
  454.         (*-------------------------------------------------------------------*)
  455.         (* A little debugging please                                         *)
  456.         (*-------------------------------------------------------------------*)
  457.  
  458.         {$IFDEF DEBUG}
  459.  
  460.           stack_test('SDATA5');
  461.  
  462.           {$IFDEF TRACE}
  463.             trace_data('5T', this_o_data^.long_length, NIL,
  464.                                                         this_o_data^.str_data);
  465.             trace_data('5I', LENGTH(in_str),           NIL, in_str);
  466.           {$ENDIF}
  467.  
  468.           {$IFDEF WRITE}
  469.             WRITELN('5T ', this_o_data^.long_length, ' -- ',
  470.                                                         this_o_data^.str_data);
  471.             WRITELN('5I ', LENGTH(in_str), ' -- ', in_str);
  472.           {$ENDIF}
  473.  
  474.         {$ENDIF}
  475.  
  476.         (*-------------------------------------------------------------------*)
  477.         (* If there is still data in the input string then loop              *)
  478.         (*-------------------------------------------------------------------*)
  479.  
  480.         WHILE LENGTH(in_str) > 0 DO
  481.           BEGIN;
  482.  
  483.             (*---------------------------------------------------------------*)
  484.             (* A little debugging please                                     *)
  485.             (*---------------------------------------------------------------*)
  486.  
  487.             {$IFDEF DEBUG}
  488.  
  489.               {$IFDEF TRACE}
  490.                 trace_data('6T', this_o_data^.long_length, NIL,
  491.                                                         this_o_data^.str_data);
  492.                 trace_data('6I', LENGTH(in_str),           NIL, in_str);
  493.               {$ENDIF}
  494.  
  495.               {$IFDEF WRITE}
  496.                 WRITELN('6T ', this_o_data^.long_length, ' -- ',
  497.                                                         this_o_data^.str_data);
  498.                 WRITELN('6I ', LENGTH(in_str), ' -- ', in_str);
  499.               {$ENDIF}
  500.  
  501.             {$ENDIF}
  502.  
  503.             (*---------------------------------------------------------------*)
  504.             (* Send this packet                                              *)
  505.             (*---------------------------------------------------------------*)
  506.  
  507.             put_a_packet;
  508.  
  509.             (*---------------------------------------------------------------*)
  510.             (* A little debugging please                                     *)
  511.             (*---------------------------------------------------------------*)
  512.  
  513.             {$IFDEF DEBUG}
  514.  
  515.               stack_test('SDATA7'); (*STACK TEST*)
  516.  
  517.               {$IFDEF TRACE}
  518.                 trace_data('7T', this_o_data^.long_length, NIL,
  519.                                                         this_o_data^.str_data);
  520.                 trace_data('7I', LENGTH(in_str),           NIL, in_str);
  521.               {$ENDIF}
  522.  
  523.               {$IFDEF WRITE}
  524.                 WRITELN('7T ', this_o_data^.long_length, ' -- ',
  525.                                                         this_o_data^.str_data);
  526.                 WRITELN('7I ', LENGTH(in_str), ' -- ', in_str);
  527.               {$ENDIF}
  528.  
  529.             {$ENDIF}
  530.  
  531.             (*---------------------------------------------------------------*)
  532.             (* Build the next packet                                         *)
  533.             (*---------------------------------------------------------------*)
  534.  
  535.             l_cat_str_size(this_o_data, in_str, this_max_pac);
  536.  
  537.             (*---------------------------------------------------------------*)
  538.             (* A little debugging please                                     *)
  539.             (*---------------------------------------------------------------*)
  540.  
  541.             {$IFDEF DEBUG}
  542.  
  543.               stack_test('SDATA8');
  544.  
  545.               {$IFDEF TRACE}
  546.                 trace_data('8T', this_o_data^.long_length, NIL,
  547.                                                         this_o_data^.str_data);
  548.                 trace_data('8I', LENGTH(in_str),           NIL, in_str);
  549.               {$ENDIF}
  550.  
  551.               {$IFDEF WRITE}
  552.                 WRITELN('8T ', this_o_data^.long_length, ' -- ',
  553.                                                         this_o_data^.str_data);
  554.                 WRITELN('8I ', LENGTH(in_str), ' -- ', in_str);
  555.               {$ENDIF}
  556.  
  557.             {$ENDIF}
  558.  
  559.           END; (*----- End loop sending packets until input stream is done --*)
  560.  
  561.       END
  562.     ELSE
  563.  
  564.       (*---------------------------------------------------------------------*)
  565.       (* Maximum packet size won't be exceeded so just glue things together  *)
  566.       (*---------------------------------------------------------------------*)
  567.  
  568.       l_cat_str_size(this_o_data, in_str, this_max_pac);
  569.  
  570.     (*-----------------------------------------------------------------------*)
  571.     (* A little debugging please                                             *)
  572.     (*-----------------------------------------------------------------------*)
  573.  
  574.     {$IFDEF DEBUG}
  575.  
  576.       stack_test('SDATA9');
  577.  
  578.       {$IFDEF TRACE}
  579.         trace_data('9T', this_o_data^.long_length, NIL, this_o_data^.str_data);
  580.         trace_data('9I', LENGTH(in_str),           NIL, in_str);
  581.       {$ENDIF}
  582.  
  583.       {$IFDEF WRITE}
  584.         WRITELN('9T ', this_o_data^.long_length, ' -- ', this_o_data^.str_data);
  585.         WRITELN('9I ', LENGTH(in_str), ' -- ', in_str);
  586.       {$ENDIF}
  587.  
  588.     {$ENDIF}
  589.  
  590.     (*-----------------------------------------------------------------------*)
  591.     (* Add line feeds as needed                                              *)
  592.     (*-----------------------------------------------------------------------*)
  593.  
  594.     add_lf;
  595.  
  596.     (*-----------------------------------------------------------------------*)
  597.     (* A little debugging please                                             *)
  598.     (*-----------------------------------------------------------------------*)
  599.  
  600.     {$IFDEF DEBUG}
  601.  
  602.       stack_pop ('SDATAA');
  603.  
  604.       {$IFDEF TRACE}
  605.         trace_data('AT', this_o_data^.long_length, NIL, this_o_data^.str_data);
  606.         trace_data('AI', LENGTH(in_str),           NIL, in_str);
  607.       {$ENDIF}
  608.  
  609.       {$IFDEF WRITE}
  610.         WRITELN('AT ', this_o_data^.long_length, ' -- ', this_o_data^.str_data);
  611.         WRITELN('AI ', LENGTH(in_str), ' -- ', in_str);
  612.       {$ENDIF}
  613.  
  614.     {$ENDIF}
  615.  
  616.     (*-----------------------------------------------------------------------*)
  617.     (* If resulting packet is too big then send it                           *)
  618.     (*-----------------------------------------------------------------------*)
  619.  
  620.     IF this_o_data^.long_length > this_max_pac THEN
  621.       put_a_packet;
  622.  
  623.     (*-----------------------------------------------------------------------*)
  624.     (* If this is a console and a CR is present then send everything we have *)
  625.     (*-----------------------------------------------------------------------*)
  626.  
  627.     IF active_tcb^.tcb_console AND (l_pos(this_o_data, cr) <> 0) THEN
  628.       send_flush;
  629.  
  630.     (*-----------------------------------------------------------------------*)
  631.     (* A little debugging please                                             *)
  632.     (*-----------------------------------------------------------------------*)
  633.  
  634.     {$IFDEF DEBUG}
  635.  
  636.       stack_pop ('SDATAB'); (*STACK TEST*)
  637.  
  638.       {$IFDEF TRACE}
  639.         trace_data('BT', this_o_data^.long_length, NIL, this_o_data^.str_data);
  640.         trace_data('BI', LENGTH(in_str),           NIL, in_str);
  641.       {$ENDIF}
  642.  
  643.       {$IFDEF WRITE}
  644.         WRITELN('BT ', this_o_data^.long_length, ' -- ', this_o_data^.str_data);
  645.         WRITELN('BI ', LENGTH(in_str), ' -- ', in_str);
  646.       {$ENDIF}
  647.  
  648.     {$ENDIF}
  649.  
  650.   END;
  651.  
  652. (*===========================================================================*)
  653. (* Flush the send buffers                                                    *)
  654. (*===========================================================================*)
  655.  
  656. PROCEDURE send_flush;
  657.  
  658.   BEGIN;
  659.  
  660.     IF active_tcb^.o_data.long_length <> 0 THEN
  661.       put_a_packet;
  662.  
  663.   END;
  664.  
  665. (*===========================================================================*)
  666. (* Flush the send buffers and wait for all the ACKS.                         *)
  667. (*===========================================================================*)
  668.  
  669. PROCEDURE send_drain;
  670.  
  671.   BEGIN;
  672.  
  673.     send_flush;
  674.  
  675.     WHILE send_unacked(TRUE) > 0 DO
  676.       task_switch;
  677.  
  678.   END;
  679.  
  680. (*===========================================================================*)
  681. (* Get number of packets in the queue but not transmitted at all             *)
  682. (*===========================================================================*)
  683.  
  684. FUNCTION send_pending(ignore_r_pending : BOOLEAN) : BYTE;
  685.  
  686.   CONST
  687.     l_command : STRING[1] = 'L';
  688.  
  689.   VAR
  690.     i         : WORD;
  691.     l_pending : BYTE;
  692.     r_pending : BYTE;
  693.     word_cnt  : BYTE;
  694.     work_str  : STRING;
  695.  
  696.   LABEL
  697.     bad_response_handler;
  698.  
  699.   BEGIN;
  700.  
  701.     (*-----------------------------------------------------------------------*)
  702.     (* If we are talking to the console, nothing can be pending              *)
  703.     (*-----------------------------------------------------------------------*)
  704.  
  705.     IF active_tcb^.tcb_console THEN
  706.       BEGIN;
  707.         task_switch;
  708.         send_pending := 0;
  709.         EXIT;
  710.       END;
  711.  
  712.     (*-----------------------------------------------------------------------*)
  713.     (* Loop around checking the link state until things are quiet            *)
  714.     (*-----------------------------------------------------------------------*)
  715.  
  716.     REPEAT
  717.  
  718.       (*---------------------------------------------------------------------*)
  719.       (* Send L command                                                      *)
  720.       (*---------------------------------------------------------------------*)
  721.  
  722. bad_response_handler:
  723.  
  724.       cmd_tnc(@l_command, FALSE);
  725.  
  726.       (*---------------------------------------------------------------------*)
  727.       (*                                                                     *)
  728.       (*  L response                                                         *)
  729.       (*      Word 1 -- Number of link status messages waiting               *)
  730.       (*      Word 2 -- Number of data packets waiting                       *)
  731.       (*      Word 3 -- Number of packets awaiting 1st transmission          *)
  732.       (*      Word 4 -- Number of frames send at least once                  *)
  733.       (*      Word 5 -- Number of retries                                    *)
  734.       (*      Word 6 -- Link status #                                        *)
  735.       (*                                                                     *)
  736.       (*---------------------------------------------------------------------*)
  737.  
  738.       WITH active_tcb^ DO
  739.         IF (tnc_type <> t_to_h_okmsg) OR (tnc_data.long_length < 3) THEN
  740.           BEGIN;
  741.             window_write_critical_i(
  742.                     'SDATA -- Improper response to L command on '
  743.                         + port_chan_s + ' -- Type was ',
  744.                     tnc_type);
  745.             window_write_critical('Answer -- ',
  746.                                    tnc_data.str_data);
  747.             DELAY(800);
  748.             GOTO bad_response_handler;
  749.           END;
  750.  
  751.       word_cnt := WORDS(active_tcb^.tnc_data.str_data);
  752.  
  753.       (*---------------------------------------------------------------------*)
  754.       (* Check for link status messages pending                              *)
  755.       (*---------------------------------------------------------------------*)
  756.  
  757.       IF word_cnt >= 1 THEN
  758.         BEGIN;
  759.           work_str := subword(@active_tcb^.tnc_data.str_data, 1, 1);
  760.           work_str[1] := work_str[LENGTH(work_str)];
  761.           IF work_str[1] >= '0' THEN
  762.             l_pending := ORD(work_str[1]) - ORD('0')
  763.           ELSE
  764.             l_pending := 1;
  765.  
  766.           IF active_tcb^.tnc_in_chn <> NIL THEN
  767.             l_pending := l_pending + pending_chain(4);
  768.  
  769.           IF l_pending > 0 THEN
  770.             link_pending;
  771.  
  772.         END
  773.       ELSE
  774.         l_pending := 0;
  775.  
  776.       (*---------------------------------------------------------------------*)
  777.       (* Check for data messages pending.  If one is pending and we can      *)
  778.       (* complete the buffer, try to do so                                   *)
  779.       (*---------------------------------------------------------------------*)
  780.  
  781.       IF (NOT ignore_r_pending) AND (l_pending = 0) AND (word_cnt >= 2) THEN
  782.         BEGIN;
  783.  
  784.           {$IFDEF DEBUG2}
  785.             WRITELN('SPEND1L -- ', active_tcb^.tnc_data.str_data);
  786.           {$ENDIF}
  787.  
  788.           (*-----------------------------------------------------------------*)
  789.           (* Calculate number of pending packets                             *)
  790.           (*-----------------------------------------------------------------*)
  791.  
  792.           work_str := subword(@active_tcb^.tnc_data.str_data, 2, 1);
  793.           work_str[1] := work_str[LENGTH(work_str)];
  794.  
  795.           {$IFDEF DEBUG2}
  796.             WRITELN('SPEND2L -- ', ORD(work_str[1]));
  797.           {$ENDIF}
  798.  
  799.           IF work_str[1] >= '0' THEN
  800.             r_pending := ORD(work_str[LENGTH(work_str)]) - ORD('0')
  801.           ELSE
  802.             r_pending := 1;
  803.  
  804.           IF LENGTH(work_str) > 1 THEN
  805.             INC(r_pending, 10);
  806.  
  807.           {$IFDEF DEBUG2}
  808.             WRITELN('SPEND3L -- ', r_pending);
  809.           {$ENDIF}
  810.  
  811.           (*-----------------------------------------------------------------*)
  812.           (* If data packets are in the queue, add them too....              *)
  813.           (*-----------------------------------------------------------------*)
  814.  
  815.           IF active_tcb^.tnc_in_chn <> NIL THEN
  816.             r_pending := r_pending + pending_chain(3);
  817.  
  818.           (*-----------------------------------------------------------------*)
  819.           (* If we have some packets pending, better see what to do          *)
  820.           (*-----------------------------------------------------------------*)
  821.  
  822.           IF r_pending <> 0 THEN
  823.             BEGIN;
  824.  
  825.               {$IFDEF DEBUG3}
  826.                 WRITELN('SPEND1P -- ', active_tcb^.tnc_data.str_data);
  827.                 WRITELN('  rpend -- ', r_pending);
  828.               {$ENDIF}
  829.  
  830.               (*-------------------------------------------------------------*)
  831.               (* Set I as a switch showing "complete" data is present        *)
  832.               (*-------------------------------------------------------------*)
  833.  
  834.               IF active_tcb^.tcb_binary THEN
  835.                 i := active_tcb^.i_data.long_length
  836.               ELSE
  837.                 i := l_pos(@active_tcb^.i_data, cr);
  838.  
  839.               (*-------------------------------------------------------------*)
  840.               (* If we don't have "complete" data, go see if we can fetch som*)
  841.               (*-------------------------------------------------------------*)
  842.  
  843.               IF (i = 0) AND (active_tcb^.i_data.long_length < 255) THEN
  844.                 BEGIN;
  845.  
  846.                   (*---------------------------------------------------------*)
  847.                   (* Poll for data only                                      *)
  848.                   (*---------------------------------------------------------*)
  849.  
  850.                   send_recv_tnc(3);
  851.  
  852.                   {$IFDEF DEBUG2}
  853.                     WRITELN('SPEND2P -- ', active_tcb^.tnc_data.str_data);
  854.                     WRITELN('  type  -- ', active_tcb^.tnc_type);
  855.                   {$ENDIF}
  856.  
  857.                   (*---------------------------------------------------------*)
  858.                   (* See if data was appropriate                             *)
  859.                   (*---------------------------------------------------------*)
  860.  
  861.                   IF (active_tcb^.tnc_type <> t_to_h_conn)
  862.                                            AND (active_tcb^.channel <> 0) THEN
  863.                       BEGIN;
  864.                         window_write_critical_i(
  865.                                 'SPENDING Improper response to G command on '
  866.                                 + active_tcb^.port_chan_s + ' -- Type was ',
  867.                                 active_tcb^.tnc_type);
  868.                         window_write_critical('Answer -- ',
  869.                                 active_tcb^.tnc_data.str_data);
  870.                         DELAY(800);
  871.                       END;
  872.  
  873.                   (*---------------------------------------------------------*)
  874.                   (* Put data in the buffer                                  *)
  875.                   (*---------------------------------------------------------*)
  876.  
  877.                   l_cat(@active_tcb^.i_data, @active_tcb^.tnc_data);
  878.  
  879.                   (*---------------------------------------------------------*)
  880.                   (* Force non-zero r_pending so we loop                     *)
  881.                   (*---------------------------------------------------------*)
  882.  
  883.                   r_pending := 1;
  884.  
  885.                 END
  886.               ELSE
  887.  
  888.                 (*-----------------------------------------------------------*)
  889.                 (* If we arrive here then we have "complete" data awaiting   *)
  890.                 (* in the buffer.  r_pending set to zero to force exit       *)
  891.                 (*-----------------------------------------------------------*)
  892.  
  893.                 r_pending := 0;
  894.  
  895.             END; (*----- End of IF (with ELSE) for "complete" data check ----*)
  896.  
  897.         END
  898.       ELSE
  899.  
  900.         (*-------------------------------------------------------------------*)
  901.         (* No data is pending, or we don't want to know about it             *)
  902.         (*-------------------------------------------------------------------*)
  903.  
  904.         r_pending := 0;
  905.  
  906.       (*---------------------------------------------------------------------*)
  907.       (* If we processed incoming data or link status then loop              *)
  908.       (*---------------------------------------------------------------------*)
  909.  
  910.     UNTIL (l_pending + r_pending) = 0;
  911.  
  912.     (*-----------------------------------------------------------------------*)
  913.     (* Get number of packets pending (but not sent yet)                      *)
  914.     (*-----------------------------------------------------------------------*)
  915.  
  916.     send_pending := 0;
  917.     IF word_cnt >= 3 THEN
  918.       BEGIN;
  919.         work_str  := subword(@active_tcb^.tnc_data.str_data, 3, 1);
  920.         l_pending := ORD(work_str[LENGTH(work_str)]);
  921.         IF l_pending > ORD('0') THEN
  922.           send_pending := l_pending - ORD('0');
  923.       END;
  924.  
  925.   END;
  926.  
  927. (*===========================================================================*)
  928. (* Get number of packets in the queue but not acked.                         *)
  929. (*===========================================================================*)
  930.  
  931. FUNCTION send_unacked(ignore_r_pending : BOOLEAN) : BYTE;
  932.  
  933.   VAR
  934.     i        : BYTE;
  935.     out_pend : BYTE;
  936.     work_str : STRING[3];
  937.  
  938.   BEGIN;
  939.  
  940.     IF active_tcb^.tcb_console THEN
  941.       BEGIN;
  942.         task_switch;
  943.         send_unacked := 0;
  944.         EXIT;
  945.       END;
  946.  
  947.     (*-----------------------------------------------------------------------*)
  948.     (* Get the number of packets in the queue but not transmitted.  This     *)
  949.     (* function call also leaves the result of the "L" command in the buffer *)
  950.     (*-----------------------------------------------------------------------*)
  951.  
  952.     out_pend := send_pending(ignore_r_pending);
  953.  
  954.     (*-----------------------------------------------------------------------*)
  955.     (* Get the number of packets in the transmitted but unacked state        *)
  956.     (*-----------------------------------------------------------------------*)
  957.  
  958.     WITH active_tcb^ DO
  959.       IF words(tnc_data.str_data) >= 4 THEN
  960.         BEGIN;
  961.           work_str := subword(@tnc_data.str_data, 4, 1);
  962.           i := ORD(work_str[LENGTH(work_str)]);
  963.           IF (i > ORD('0')) AND (out_pend < ORD('0')) THEN
  964.             out_pend := out_pend + i - ORD('0');
  965.         END;
  966.  
  967.     (*-----------------------------------------------------------------------*)
  968.     (* Got'em                                                                *)
  969.     (*-----------------------------------------------------------------------*)
  970.  
  971.     send_unacked := out_pend;
  972.  
  973.   END;
  974.  
  975. (*===========================================================================*)
  976. (* Put a packet                                                              *)
  977. (*===========================================================================*)
  978.  
  979. PROCEDURE put_a_packet;
  980.  
  981.   VAR
  982.     dl           : WORD;
  983.     prefix       : STRING[4];
  984.     x_timeout    : LONGINT;
  985.  
  986.   {$UNDEF DEBUG}
  987.  
  988.   BEGIN;
  989.  
  990.     WITH active_tcb^ DO
  991.       BEGIN;
  992.  
  993.         (*-------------------------------------------------------------------*)
  994.         (* Some debugging please                                             *)
  995.         (*-------------------------------------------------------------------*)
  996.  
  997.         {$IFDEF DEBUG}
  998.  
  999.           dl := o_data.long_length;
  1000.  
  1001.           WRITELN('PUTA0 --', dl, '-', o_data.str_data);
  1002.  
  1003.           IF dl = 0 THEN
  1004.             DELAY(1000);
  1005.  
  1006.         {$ENDIF}
  1007.  
  1008.         (*-------------------------------------------------------------------*)
  1009.         (* Add linefeeds as needed                                           *)
  1010.         (*-------------------------------------------------------------------*)
  1011.  
  1012.         add_lf;
  1013.  
  1014.         (*-------------------------------------------------------------------*)
  1015.         (* Some debugging please                                             *)
  1016.         (*-------------------------------------------------------------------*)
  1017.  
  1018.         {$IFDEF DEBUG}
  1019.  
  1020.           dl := o_data.long_length;
  1021.  
  1022.           WRITELN('PUTA1 --', dl, '-', o_data.str_data);
  1023.  
  1024.           IF dl = 0 THEN
  1025.             DELAY(1000);
  1026.  
  1027.         {$ENDIF}
  1028.  
  1029.         (*-------------------------------------------------------------------*)
  1030.         (* Get the data length                                               *)
  1031.         (*-------------------------------------------------------------------*)
  1032.  
  1033.         dl := o_data.long_length;
  1034.  
  1035.         (*-------------------------------------------------------------------*)
  1036.         (* Some debugging please                                             *)
  1037.         (*-------------------------------------------------------------------*)
  1038.  
  1039.         {$IFDEF DEBUG}
  1040.  
  1041.           WRITELN('PUTAPACKET --', dl, '-', o_data.str_data);
  1042.  
  1043.           IF dl = 0 THEN
  1044.             DELAY(1000);
  1045.  
  1046.         {$ENDIF}
  1047.  
  1048.         (*-------------------------------------------------------------------*)
  1049.         (* If no data at this point, we leave                                *)
  1050.         (*-------------------------------------------------------------------*)
  1051.  
  1052.         IF dl = 0 THEN
  1053.           EXIT;
  1054.  
  1055.         (*-------------------------------------------------------------------*)
  1056.         (* Prepare the display prefix                                        *)
  1057.         (*-------------------------------------------------------------------*)
  1058.  
  1059.         prefix := port_chan_s + '>:';
  1060.  
  1061.         (*-------------------------------------------------------------------*)
  1062.         (* Calculate the transmitter time out.  Its BIG!                     *)
  1063.         (*-------------------------------------------------------------------*)
  1064.  
  1065.         x_timeout := current_day_time + active_port^.time_out
  1066.                                       + active_port^.time_out;
  1067.  
  1068.         (*-------------------------------------------------------------------*)
  1069.         (* If too many packets already outstanding then wait for it to clear *)
  1070.         (*-------------------------------------------------------------------*)
  1071.  
  1072.         WHILE (active_port^.port_pend - send_pending(TRUE)) <= 0 DO
  1073.           BEGIN;
  1074.  
  1075.             (*---------------------------------------------------------------*)
  1076.             (* Transmitter time out                                          *)
  1077.             (*---------------------------------------------------------------*)
  1078.  
  1079.             IF current_day_time > x_timeout THEN
  1080.               BEGIN;
  1081.                 prefix := port_chan_s + 'T:';
  1082.                 window_write(prefix, 'Transmit time out');
  1083.                 force_tcb(active_tcb);
  1084.               END;
  1085.  
  1086.             (*---------------------------------------------------------------*)
  1087.             (* Wait at bunch of switch periods before proceeding             *)
  1088.             (*---------------------------------------------------------------*)
  1089.  
  1090.             FOR dl := 1 TO 40 DO
  1091.               task_switch;
  1092.  
  1093.           END;
  1094.  
  1095.         (*-------------------------------------------------------------------*)
  1096.         (* Some debugging please                                             *)
  1097.         (*-------------------------------------------------------------------*)
  1098.  
  1099.         {$IFDEF DEBUG}
  1100.           WRITELN('ENDWAIT');
  1101.         {$ENDIF}
  1102.  
  1103.         (*-------------------------------------------------------------------*)
  1104.         (* Move the data into the output buffer                              *)
  1105.         (*-------------------------------------------------------------------*)
  1106.  
  1107.         tnc_data := o_data;
  1108.  
  1109.         (*-------------------------------------------------------------------*)
  1110.         (* Display if wanted                                                 *)
  1111.         (*-------------------------------------------------------------------*)
  1112.  
  1113.         IF NOT tcb_no_show_sdata THEN
  1114.           window_write(prefix, tnc_data.str_data);
  1115.  
  1116.         (*-------------------------------------------------------------------*)
  1117.         (* Some debugging please                                             *)
  1118.         (*-------------------------------------------------------------------*)
  1119.  
  1120.         {$IFDEF DEBUG}
  1121.           WRITELN('PAP-WHICH');
  1122.           DELAY(500);
  1123.         {$ENDIF}
  1124.  
  1125.         (*-------------------------------------------------------------------*)
  1126.         (* If this is not a console or we are not killing the task           *)
  1127.         (*-------------------------------------------------------------------*)
  1128.  
  1129.         IF NOT (tcb_console OR tcb_dead_in_progress) THEN
  1130.           BEGIN;
  1131.  
  1132.             (*---------------------------------------------------------------*)
  1133.             (* Some debugging please                                         *)
  1134.             (*---------------------------------------------------------------*)
  1135.  
  1136.             {$IFDEF DEBUG}
  1137.               WRITELN('PAP-SRT');
  1138.               DELAY(500);
  1139.             {$ENDIF}
  1140.  
  1141.             (*---------------------------------------------------------------*)
  1142.             (* Send the data and check the response                          *)
  1143.             (*---------------------------------------------------------------*)
  1144.  
  1145.             send_recv_tnc(info_cmd_info);
  1146.             IF tnc_type <> t_to_h_ok THEN
  1147.               put_data_error;
  1148.  
  1149.           END
  1150.         ELSE
  1151.           REPEAT
  1152.  
  1153.             (*---------------------------------------------------------------*)
  1154.             (* Console or task is to die.  If we are killing the task        *)
  1155.             (* then this loop will never end                                 *)
  1156.             (*---------------------------------------------------------------*)
  1157.  
  1158.             (*---------------------------------------------------------------*)
  1159.             (* Some debugging please                                         *)
  1160.             (*---------------------------------------------------------------*)
  1161.  
  1162.             {$IFDEF DEBUG}
  1163.               WRITELN('PAP-DEAD LOOP');
  1164.             {$ENDIF}
  1165.  
  1166.             (*---------------------------------------------------------------*)
  1167.             (* Switch tasks and get pending send info                        *)
  1168.             (*---------------------------------------------------------------*)
  1169.  
  1170.             task_switch;
  1171.             dl := send_pending(TRUE);
  1172.  
  1173.           UNTIL NOT tcb_dead_in_progress;
  1174.  
  1175.         (*-------------------------------------------------------------------*)
  1176.         (* Switch tasks to let someone else get a shot                       *)
  1177.         (*-------------------------------------------------------------------*)
  1178.  
  1179.         task_switch;
  1180.  
  1181.         (*-------------------------------------------------------------------*)
  1182.         (* Clear buffer                                                      *)
  1183.         (*-------------------------------------------------------------------*)
  1184.  
  1185.         o_data.long_length := 0;
  1186.         o_data.str_data    := '';
  1187.  
  1188.       END;
  1189.  
  1190.   END;
  1191.  
  1192. (*===========================================================================*)
  1193. (* Non blank answer received when putting data to the TNC                    *)
  1194. (*===========================================================================*)
  1195.  
  1196. PROCEDURE put_data_error;
  1197.  
  1198.   BEGIN;
  1199.     window_write_critical(active_tcb^.port_chan_s
  1200.                                    + 'Non null response to data transmission',
  1201.                           active_tcb^.tnc_data.str_data);
  1202.   END;
  1203.  
  1204. END.
  1205.